home *** CD-ROM | disk | FTP | other *** search
/ Aminet 38 / Aminet 38 (2000)(Schatztruhe)[!][Aug 2000].iso / Aminet / dev / misc / relocs.lha / relocs.e next >
Encoding:
Text File  |  2000-05-11  |  3.6 KB  |  145 lines
  1. MODULE 'dos/dos', 'dos/doshunks'
  2.  
  3. OBJECT hunk
  4.   type
  5.   offset
  6.   reloc_type
  7.   reloc_offset
  8. ENDOBJECT
  9.  
  10. DEF fh, hunks:PTR TO hunk
  11.  
  12. PROC main()
  13.   DEF filename=NIL, rdargs
  14.   IF rdargs := ReadArgs('FILE/A', {filename}, NIL)
  15.     IF fh := Open(filename, MODE_OLDFILE)
  16.       mainpart()
  17.       Close(fh)
  18.     ENDIF
  19.     FreeArgs(rdargs)
  20.   ENDIF
  21. ENDPROC
  22.  
  23. PROC mainpart() HANDLE
  24.   DEF n, lo, hi, hunk, hunklen
  25.  
  26.   IF get() <> HUNK_HEADER THEN RETURN PrintF('no HUNK_HEADER\n')
  27.   IF get() <> 0           THEN RETURN PrintF('hunk_name not 0\n')
  28.  
  29.   -> read basic facts of hunk
  30.   PrintF('\d hunks in file\nHunks \d to \d are directly loaded\n',
  31.     n := get(), lo := get(), hi := get()
  32.   )
  33.  
  34.   -> get hunk memory requirements
  35.   PrintF('Hunk memory requirements:\n')
  36.   FOR n := lo TO hi DO PrintF('hunk \z\d[2]: \d[8] bytes of \s mem\n', n,
  37.     Shl((hunk := get()) AND $1fffffff, 2),
  38.     IF hunk AND HUNKF_FAST THEN (
  39.       IF hunk AND HUNKF_CHIP THEN get() BUT 'CUSTOM' ELSE 'FAST'
  40.     ) ELSE (
  41.       IF hunk AND HUNKF_CHIP THEN 'CHIP' ELSE 'ANY '
  42.     )
  43.   )
  44.  
  45.  
  46.   NEW hunks[n]
  47.  
  48.   PrintF('\nHunk scan:\n')
  49.   FOR n := lo TO hi
  50.     hunks[n].type := hunk := (get() AND $1fffffff)
  51.  
  52.     IF ((hunk <> HUNK_CODE) AND (hunk <> HUNK_DATA) AND
  53.         (hunk <> HUNK_BSS)  AND (hunk <> HUNK_DEBUG))
  54.       RETURN PrintF('hunk \z\d[2]: Unknown hunk \s ($\h)\n',
  55.         n, hunkname(hunk), hunk)
  56.     ENDIF
  57.  
  58.     hunklen := Shl(get(), 2)
  59.     hunks[n].offset := here()
  60.  
  61.     PrintF('hunk \z\d[2]: \l\s[12] ($\h) offset \d, \d bytes length\n',
  62.       n, hunkname(hunk), hunk, hunks[n].offset, hunklen
  63.     )
  64.  
  65.     IF (hunk <> HUNK_BSS) THEN skip(hunklen)
  66.  
  67.     hunks[n].reloc_type := hunk := get()
  68.     SELECT hunk
  69.     CASE HUNK_RELOC32; hunk := 3
  70.     CASE HUNK_RELOC16; hunk := 2
  71.     CASE HUNK_RELOC8;  hunk := 1
  72.     CASE HUNK_END;     hunk := 0
  73.     DEFAULT; skip(-4); hunk := 0
  74.     ENDSELECT
  75.  
  76.     IF hunk > 0
  77.        hunks[n].reloc_offset := here()
  78.        REPEAT
  79.          IF (hunklen := get()) <> 0 THEN skip(Shl(hunklen,hunk-1)+4)
  80.        UNTIL hunklen = 0
  81.     ENDIF
  82.  
  83.     IF get() <> HUNK_END THEN skip(-4)
  84.   ENDFOR
  85.  
  86.   PrintF('\nReloc dump:\n')
  87.   FOR n := lo TO hi
  88.     hunk := hunks[n].reloc_type
  89.     SELECT hunk
  90.     CASE HUNK_RELOC32; goto(hunks[n].reloc_offset); print_reloc(n, {get})
  91.     CASE HUNK_RELOC16; goto(hunks[n].reloc_offset); print_reloc(n, {get16})
  92.     CASE HUNK_RELOC8;  goto(hunks[n].reloc_offset); print_reloc(n, {get8})
  93.     ENDSELECT
  94.   ENDFOR
  95.  
  96. EXCEPT
  97. ENDPROC
  98.  
  99. PROC print_reloc(thishunk, getproc)
  100.   DEF n, hunk, offset, h, off2, x
  101.   IF (n := get()) = 0 THEN RETURN
  102.   hunk := get()
  103.   FOR x := 1 TO n
  104.     offset := getproc()
  105.     h := here()
  106.     goto(hunks[thishunk].offset+offset)
  107.     off2 := getproc()
  108.     goto(h)
  109.     PrintF(
  110.       'hunk \z\r\d[2] : $\z\r\h[8] -> hunk \z\r\d[2] : $\z\r\h[8]\n',
  111.       thishunk, offset, hunk, off2
  112.     )
  113.     IF CtrlC() THEN Raise()
  114.   ENDFOR
  115.   print_reloc(thishunk, getproc)
  116. ENDPROC
  117.  
  118.  
  119. PROC get()
  120.   DEF x=0; IF Read(fh, {x}, 4) < 0 THEN Raise()
  121. ENDPROC x
  122.  
  123. PROC get16()
  124.   DEF x=0; IF Read(fh, {x}+2, 2) < 0 THEN Raise()
  125. ENDPROC x
  126.  
  127. PROC get8()
  128.   DEF x=0; IF Read(fh, {x}+3, 1) < 0 THEN Raise()
  129. ENDPROC x
  130.  
  131.  
  132. PROC skip(x) IS Seek(fh, x, OFFSET_CURRENT)
  133. PROC here() IS Seek(fh, 0, OFFSET_CURRENT)
  134. PROC goto(x) IS Seek(fh, x, OFFSET_BEGINNING)
  135.  
  136. PROC hunkname(hunk) IS
  137.   IF (hunk < HUNK_UNIT) OR (hunk > HUNK_ABSRELOC16) THEN '???' ELSE ListItem([
  138.     'HUNK_UNIT', 'HUNK_NAME', 'HUNK_CODE', 'HUNK_DATA', 'HUNK_BSS',
  139.     'HUNK_RELOC32', 'HUNK_RELOC16', 'HUNK_RELOC8', 'HUNK_EXT',
  140.     'HUNK_SYMBOL', 'HUNK_DEBUG', 'HUNK_END', 'HUNK_HEADER', '???',
  141.     'HUNK_OVERLAY', 'HUNK_BREAK', 'HUNK_DREL32', 'HUNK_DREL16',
  142.     'HUNK_DREL8', 'HUNK_LIB', 'HUNK_INDEX', 'HUNK_RELOC32SHORT',
  143.     'HUNK_RELRELOC32', 'HUNK_ABSRELOC16'
  144.   ], hunk-HUNK_UNIT)
  145.